Wonky Flux Batch 2019 02

home *** CD-ROM | disk | FTP | other *** search

/ Wonky Flux Batch 2019 02 / Wonky_Flux_Batch_2019-02.zip / Wonky Flux Batch 2019-02 / 090 - CAD Draw.dsk / T.APSOFT IV.s < prev

Wrap

Text File | 2019-02-17 | 24KB | 881 lines

PAG ***************************** * T * * Applesof;PGPPart IV * * {{{ * * Copywrite Apple Computer, * * Inc. and Microsoft, Inc.; * * not for publication or * * distribution. * * * ***************************** * * * Graphics, etc. * * * * $F1D5 - $F7FF * * * ***************************** CALL JSR FRMNUM ;Note that CALL does not set up JSR GETADR ; registers as in INTEGER BASIC JMP (LINNUM) ;On a CALL: ; Y has low byte CALL adrs ; A has high byte CALL adrs ; X has $9D INNU JSR GETBYT ;IN# TXA JMP INPORT PRNU JSR GETBYT ;PR# TXA JMP OUTPORT * Lores subroutines: * Subroutine to get *,* coordinates: PLOTFNS JSR GETBYT ;Get first coordinate CPX #48 ;Make sure it is < 48 BCS GOERR STX FIRST LDA #',' JSR SYNCHR ;Syntax check JSR GETBYT ;Get 2nd coor CPX #48 ;Must be <48 BCS GOERR STX H2 ;Set up both H2 STX V2 ; and V2 RTS GOERR JMP IQERR LINCOOR JSR PLOTFNS ;Get A,B coor CPX FIRST ;Is B<A? BCS AT? ;Branch if not LDA FIRST ;Interchange them if so STA H2 STA V2 STX FIRST AT? LDA #at JSR SYNCHR ;Syntax check JSR GETBYT CPX #48 ;Check < 48 BCS GOERR RTS PLOT JSR PLOTFNS TXA LDY FIRST CPY #40 ;X coordinate must be <40 BCS GOERR JMP MONPLOT HLIN= R LINCOOR TXA LDY H2 CPY #40 ;X coor must be <40 BCS=rERR LDY FIRST JMP=yINE ;Go to monitor routine VLIN JSR LIN^zR TXA TAY CPY #40 ;X coor mun7zbe <40 BCS GOERR LDA FIRST JMP VLINE ;Go to monitor routine COLOR JSR GETBYT TXA JMP SETCOL * Non graphics stuff: VTAB JSR GETBYT DEX TXA CMP #24 ;Range ok? BCS GOERR JMP TABV ;Use monitor routine SPEED JSR GETBYT TXA ;$1G-SPEED ->%*AEDZ EOR #$FF TAX INX STX SPEEDZ RTS TRACE SEC HEX 90 ;Fake BCC to skip NOTRACE CLC ROR TRCFLG RTS NORMAL LDA #$FF BNE NRM INVERSE LDA #$3F NRM LDX #0 SI STA INVFLG STX ORMASK RTS FLASH LDA #$7F LDX #$40 BNE SI HIMEM JSR FRMNUM ;Get specified HIMEM JSR GETADR >>> CMPR.LINNUM;STREND BGE SETHI ;Above variable table? JMM JMP MEMERR ;Error if not SETHI LDA LINNUM STA MEMSIZ STA FRETOP LDA LINNUM+1 STD`0 ;s GUQ"1/o7INo5 %,Xij(@UVf"l!g2M<LyTW["J~KDDY3T@}Sth<#maG~q=dSawS`:@CMPR.LINNUM;VARTAB BLT JMM >>> TRDB.LINNUM;VARTAB JMP CLEARC ;LOMEM clears variables ONERR LDA #goto JSR SYNCHR >>> TRDB.TXTPTR;TXTPSV SEC ROR ERRFLG >>> TRDB.CURLIN;CURLSV JSR REMN ;Ignore rest of line JMP ADDON * Routine to handle errors if ONERR GOTO active: HANDLERR STX ERRNUM LDX REMSTK ;Get stack ptr saved at NEWSTT STX ERRSTK ;Remember it ;(Should also have done TXS ; here; see ONERR correction ; in Applesoft manual.) >>> TRDB.CURLLN;ERQLIN >>> TRDB.OLDTEXT;ERRPOS >>>%-Cl[bl3 e{cAA]4a=0GPW|B![CURLyxhCURLIN JSR CHRGOT JSR GOTO ;Goto specified ONERR line JMP NEWSTT RESUME >>> TRDB.ERRLIN;CURLIN >>> TRDB.ERRPOS;TXTPTR LDX ERRSTK ;Retrieve stack ptr as it was TXS ; when error was encountered JMP NEWSTT JSYN JMP SYNERR DEL BCS JSYN ;Error if # not specified >>> TRX.PRGEND ;VARTAB JSR LINGET ;Get beginning of range JSR FNDLIN ;Find this line or next >>> TRDB.LOWTR ;DEST LDA #',' JSR SYNCHR ;Check syntax JSR LINGET ;Get end range ;(Does nothing if end range ; not specified.) >>> INCR.LINNUM ;Point 1 past it JSR FNDLIN ;Find next line to it >>> CMPR.LOWTR ;DEST BGE MOVDWN ;Do move unless it is RTS ; an invalid range MOVDWN LDY #0 ;Move LOWTR through VARTAB MOVIT LDA (LOWTR),Y ; to DEST STA (DEST),Y >>> INCR.LOWTR >>> INCR.DEST >>> CMPR.VARTAB;LOWTR BGE MOVIT LDX DEST+1 ;Set Y,X to DEST-1 LDY DEST BNE NDX DEX NDX DEY STX VARTAB+1 ;Point VARTAB to last STY VARTAB ; byte moved JMP LINKSET ;Reset links after a delete GR LDA LORES LDA MIXSET JMP S[GR TEXT LDA LOWSCR ;JMP $FB36 would have JMP SETTXT ; done both these. * Tape array store and recall routines: * (No corresponding routines for disk in Applesoft.) STORE JSR GETARYPT LDY #3 LDA (LOWTR),Y TAX DEY LDA (LOWTR),Y SBC #1 BCS SLI DEX ZLI STA LINNUM STX LINNUM+1 JSR WRITE JSR TAPEPNT JMP WRITE RECALL JSR GETARYPT JSR MONREAD LDY #2 LDA (LOWTR),Y CMP LINNUM INY LDA (LOWTR),Y SBC LINNUM+1 BCS MOK JMP MEMERR MOK JSR TAPEPNT JMP MONREAD * Hires initialization routines: HGR2 BIT HISCR BIT MIXCLR ;Default to full screen LDA #$40 BNE SETHPG HGR LDA #$20 BIT LOWSCR BIT MIXSET ;Default to mixed screen SETHPG STA HPAG LDA HIRES LDA TXTCLR HCLR LDA #0 ;Set for black bkgrnd STA HCOLOR1 BKGND LDA HPAG ;Init hires screen mem STA SHAPEH LDY #0 STY SHAPEL BKGND1 LDA HCOLOR1 STA (SHAPEL),Y ;Clear hires to HCOLOR1 JSR CSHFT2 ;Correct for color shift INY ;(Slows clear by factor of 2) BNE BKGND1 INC SHAPEH LDA SHAPEH AND #$1F ;Done? BNE BKGND1 RTS * Hires position and plot subroutines HPOSN STA Y0 ;Enter with Y in A-reg STX X0L ; XL in X-reg, STY X0H ; and XH in Y-reg. PHA AND #$C0 STA GBASL ;For y-coor = 00ABCDEF LSR ;calculates base addr LSR ;in GBASL,GBASH for ORA GBASL ;accessing screen memory STA GBASL ;via (GBASL),Y. PLA STA GBASH ASL ;Calculates ASL ; GBASH = PPPFGHCD, ASL ; GBASL = EABAB000 ROL GBASH ;where PPP=001 for $2000-$3FFF ASL ;and PPP=010 for $4000-$5FFF, ROL GBASH ;given y-coor = ABCDEFGH ASL ROR GBASL LDA GBASH AND #$1F ORA HPAG STA GBASH TXA ;Divide X0 by 7 for CPY #0 ;index from base adrs (quotient) BEQ HPOSN2 ;and bit within screen mem byte LDY #$23 ;(mask specified by remainder). ADC #4 HPOSN1 INY HPOSN2 SBC #7 BCS HPOSN1 STY HNDX ;Works for X0 from 0 to 279, TAX ;low byte in X-reg, high in LDA MSKTBL-$F9,X STA HMASK ;Y-reg on entry. TYA LSR LDA HCOLORZ ;If on odd byte (carry set) STA HCOLOR1 ;then rotate bits BCS CSHFT2 RTS HPLOT0 JSR HPOSN LDA HCOLOR1 ;Calculate bit posn in GBAS, EOR (GBASL),Y ; HNDX, and HMASK from AND HMASK ; Y-coor in A-reg, EOR (GBASL),Y ; X-coor in X,Y regs. STA (GBASL),Y ;For any 1-bits, substitute RTS ;corresp bit of HCOLOR1. * Hires L,R,U,D subroutines LFTRT BPL RIGHT ;Use sign for left/right subr. LEFT LDA HMASK LSR ;Shift low-order 7 bits BCS LEFT1 ; of HMASK one bit posn. EOR #$C0 LR1 STA HMASK RTS LEFT1 DEY ;Decr horiz index BPL LEFT2 LDY #$27 ;Wrap around screen LEFT2 LDA #$C0 ;New HMASK, rightmost NEWNDX STA HMASK ; dot of byte. STY HNDX ;Update horiz index. CSHIFT LDA HCOLOR1 CSHFT2 ASL ;Rotate low-order 7 bits CMP #$C0 ; of HCOLOR1 one bit posn. BPL RTS1 ;Branch if black or white LDA HCOLOR1 EOR #$7F STA HCOLOR1 RTS1 RTS RIGHT LDA HMASK ASL ;Shift low order 7 bits EOR #$80 ; of HMASK one bit posn. BMI LR1 LDA #$81 INY ;Next byte CPY #40 BCC NEWNDX LDY #0 ;Wrap around BCS NEWNDX ;Always taken LRUDX1 CLC ;No 90 deg rot LRUDX2 LDA DXH AND #4 ;If bit2=0 then no plot BEQ LRUD4 LDA #$7F AND HMASK AND (GBASL),Y ;Screen bit set? BNE LRUD3 INC COLCOUNT LDA #$7F AND HMASK BPL LRUD3 ;Always LRUD1 CLC ;No 90 deg rot LRUD2 LDA DXH AND #4 ;If bit2=0 then no plot BEQ LRUD4 LDA (GBASL),Y EOR HCOLOR1 ;Set hires screen bit AND HMASK ; to corresponding HCOLOR. BNE LRUD3 ;If screen bit changes, INC COLCOUNT ;then incr collsn count. LRUD3 EOR (GBASL),Y STA (GBASL),Y LRUD4 LDA DXH ;Add quadrant to specified ADC QDRNT ; vector and move lft, rt, AND #3 ; up, or down based on EQ3 = *-1 ; sign and carry. CMP #2 ROR BCS LFTRT UPDOWN BMI DOWN ;Sign for up/down select. UP CLC LDA GBASH ;Calc base adrs for next BIT EQ1C ; line up in (GBAS) BNE UP4 ; with 192-line wrap around. ASL GBASL BCS UP2 BIT EQ3 BEQ UP1 ADC #$1F ;**** BIT MAP **** SEC BCS UP3 ;for row = ABCDEFGH UP1 ADC #$23 PHA LDA GBASL ;GBASL = EABAB000 ADC #$B0 ;GBASH = PPPFGHCD BCS UP5 ADC #$F0 ;where PPP=001 for pg1 UP5 STA GBASL PLA BCS UP3 UP2 ADC #$1F UP3 ROR GBASL UP4 ADC #$FC UPDWN1 STA GBASH RTS CLC DOWN LDA GBASH ADC #4 ;Calc base adr for next EQ4 = *-1 ; line down, with 192 BIT EQ1C ; line wrap around. BNE UPDWN1 ASL GBASL BCC DOWN1 ADC #$E0 CLC BIT EQ4 BEQ DOWN2 LDA GBASL ADC #$50 EOR #$F0 BEQ DOWN3 EOR #$F0 DOWN3 STA GBASL LDA HPAG BCC DOWN2 DOWN1 ADC #$E0 DOWN2 ROR GBASL BCC UPDWN1 * Hires line draw subroutines HLINRL PHA LDA #0 ;Set X0L,H and Y0 STA X0L ; to 0 for rel line draw STA X0H ; (DX,DY). STA Y0 PLA HGLIN PHA ;On entry: SEC ; XL: A-reg SBC X0L ; XH: X-reg PHA ; Y: Y-reg TXA SBC X0H STA QDRNT ;Calc ABS(X-X0) BCS HLIN2 ; in (DXL,H) PLA EOR #$FF ;X dir to sign bit ADC #1 ; of qdrnt. PHA ; 0=right (DX pos) LDA #0 ; 1=left (DX neg) SBC QDRNT HLIN2 STA DXH STA EH ;Init EL,H to ABS(X-X0) PLA ; = DELTX STA DXL STA EL PLA STA X0L ;Set ptr to end of line STX 80H TYA CLC @SBC Y0 ;Calc -DELTY-1 in DY where @BCC HLgcd_?!Y =INfw WM)/EOR #Du}X#$FE HLIN3 STA DY ;Rotate Y dir into STY Y0 ; qdrnt sign bit ROR QDRNT ; (0=up, 1=down) SEC SBC DXL ;Init COUNTL,H (COUNTL=X-reg) TAX ; to -(DELTX+DELTY+1) LDA #$FF SBC DXH STA COUNTH LDY HNDX ;Horiz index. BCS MOVEX2 ;Always taken. MOVEX ASL ;Move in X-dir. Use JSR LFTRT ; QDRNT bit6 for lft/rt set. SEC MOVEX2 LDmEL ;As$:[zSWjJRzajVJcU{>1n1^8jY39T=!-TvrUW}ji @T$,LPote: DY is (-DELTY)-1 LDA EH ;Carry clr if (EL,H) goes neg. SBC #0 ;= ADC #$FF HCOUNT STA EH LDA (GBASL),Y EOR HCOLOR1 ;Plot dot of HCOLOR1. AND HMASK EOR (GBASL),Y STA (GBASL),Y INX ;Done (DELTX+DELTY) dots? BNE HLIN4 INC COUNTH BEQ RTS2 ;Yes, return. HLIN4 LDA QDRNT ;For direction test. BCS MOVEX ;If carry set, (EL,H) plot JSR UPDOWN ; if clr, neg, move CLC LDA EL ;(EL,H)+DELTX to (EL,H). ADC DXL STA EL LDA EH ADC DXH BVC HCOUNT ;Always taken MSKTBL DFB %10000001 DFB %10000010 DFB %10000100 DFB %10001000 DFB %10010000 DFB %10100000 DFB %11000000 EQ1C HEX 1C * Table of COS(90*X/16 degrees)*$100 - 1 with * one byte precision, X=0 to 16: COSTBL HEX FFFEFAF4ECE1D4C5 HEX B4A18D7861493118 HEX FF * Hires coordinate restore subroutine: * (not called by any Applesoft routine) HFIND LDA GBASL ;Converts base adrs ASL LDA G6ASH ; to y-coor. AND #3BP8?L ;For GBASL=EABAB000 ORASL ; GBASH=PPPFGHCD ASL ASL ;generate ASL ; Y-coor=ABCDEFGH STA Y0 LDA GBASH ;(PPP=screen page) LSR LSR AND #7 ORA Y0 STA Y0 ;Converts HNDX (index from LDA HNDX ; base adrs) and HMASK ASL ; (bit mask) to x-coor ADC HNDX ; in (X0L,H), range ASL ; 0-$133 TAX DEX LDA HMASK AND #$7F HFIND1 INX LSR BNE HFIND1 STA X0H TXA CLC ;Calc HNDX*7+LOG(HMASK), base 2 ADC HNDX BCC HFIND2 INC X0H HFIND2 STA X0L RTS2 RTS * Hires shape drawing subroutines DRAW0 STX SHAPEL ;Shape pointer STY SHAPEH DRAW1 TAX ;A holds ROT (0-$3F) LUP 4 LSR --^ STA QDRNT ;QDRNT 0=UP, 1=RT TXA ; 2=DWN, 3=LFT AND #$F TAX LDY COSTBL,X ;Save COS and SIN STY DXL ; values in DXL and DY. EOR #$F TAX LDY COSTBL+1,X INY STY DY LDY HNDX ;Index from base adrs. LDX #0 STX COLCOUNT ;Clear collision count. LDA (SHAPEL,X) ;First byte of shape defn DRAW2 STA DXH LDX #$80 STX EL ;EL,H for fractional STX EH ; L,R,U,D vectors. LDX SCALEZ ;Scale factor. DRAW3 LDA EL SEC ;If frac. cos overflow ADC DXL ; then move in specified STA EL ; vector direction. BCC DRAW4 JSR LRUD1 CLC DRAW4 LDA EH ;If frac. sin overflow ADC DY ; then move in specified STA EH ; direction+90 deg. BCC DRAW5 JSR LRUD2 DRAW5 DEX ;Loop on scale factor. BNE DRAW3 LDA DXH LSR ;Next 3 \. vector LSR ; of shape defn. LSR BNE DRAW2 ;Not done i]3s byte. >>> INCR.SUp EL LDA (SHAPEL,X) ;Next byte of shape dxS4. BNE DRAW2 ;Done if 0. RTS 7cires shape xdraw subroutine: XDRAW0 STX SHAPEL ;See DRAW comments STY SHAPEH XDRAW1 TAX LUP 4 LSR --^ STA QDRNT TXA AND #$F TAX LDY COSTBL,X STY DXL EOR #$F TAX LDY COSTBL+1,X INY STY DY LDY HNDX LDX #0 STX COLCOUNT ;qA (SHAPEL)!8FXDRAW2 STA DXH LDX #$80 STX EL STX EH LDX SCALEZ XDRAW3 LDA EL SEC ADC DXL STA EL BCC XDRAW4 JSR LRUDX1 CLC XDRAW4 >>> AD.EH ;DY;EH BCC XDRAW5 JSR LRUDX2 XDRAW5 DEX BNE XDRAW3 LDA DXH LSR LSR LSR BNE XDRAW2 >>> INCR.SHAPEL LDA (SHAPEL,X) BNE XDRAW2 RTS * Parsing routines used by BASIC for Hires access: HFNS JSR FRMNUM JSR GETADR LDY LINNUM+1 ;Get horiz coor in X,Y LDX LINNUM CPY #>280 ;Make suwA 7&jG{5n1+q&=I W.=R31>bb WJ!iFdfjrzO!o%M<NhGM=RaE~\QUiL,|x3v >DPG"c3%VZ=]jMS$o(A TYA PHA LDA #',' JSR SYNCHR ;Check syntax JSR GETBYT ;Get vert coor CPX #$C0 ;Check it is < $C0 = 192 BGE GGERR STX DSCTMP ;Save it PLA ;Retrieve horiz coor TAY PLA TAX LDA DSCTMP ; and vert coor RTS ;Return to caller GGERR JMP GOERR ;Illegal quantity HCOLOR JSR GETBYT CPX #8 BGE GGERR LDA COLORTBL,X STA HCOLORZ RTS3 RTS COLORTBL DFB %00000000 ;Black1 DFB %00101010 ;Green DFB %01010101 ;Violet DFB %01111111 ;White1 DFB %10000005 ;Blbck2 DFB %10101010 ;Orange DFB %4H!)}ZKJ!Y5I&q5H_Xm'{T(;Whi^Ka HPLOT CMP #to ;Continued plot requested? BEQ HP3 ;Branch if so JSR HFNS ;Get coor of start point JSR HPLOT0 ;Plot it, setting up coor HP2 JSR CHRGOT CMP #to ;Line specified? BNE RTS3 ;Exit if not HP3 JSR SYNCHR JSR HFNS ;Get coor of line end STY DSCTMP ;Set up for line TAY TXA LDX DSCTMP JSR HGLIN ;Plot line JMP HP2 ;Loop till no more "TO" ROT JSR GETBYT STX ROTZ RTS SCALE JSR GETBYT STX SCALEZ RTS DRWPNT JSR GETBYT ;Shape number specified >>> TRDB.SHAPEPNT;SHAPEL TXA LDX #0 CMP (SHAPEL,X) ;Shape defined in table? BEQ DP1 BGE GGERR ;Error if not DP1 ASL ;Find address of shape BCC DP2 ; from table. INC SHAPEH CLC DP2 TAY LDA (SHAPEL),Y ADC SHAPEL TAX INY LDA (SHAPEL),Y ADC SHAPEPNT+1 STA SHAPEH ;Save adrs of shape STX SHAPEL JSR CHRGOT ;Check syntax CMP #at BNE DP3 JSR SYNCHR JSR HFNS ;Draw it where? JSR HPOSN DP3 LDA ROTZ RTS DRAW JSR DRWPNT ;Entries from BASIC JMP DRAW1 XDRAW JSR DRWPNT JMP XDRAW1 * Load shape table from ta'j: SHLOAD LDA #0 STA A1H STA A2H LDY #LINNUM STY A1L INY STY A2L JSR MONREAD ;Read length to LINNUM CLC LDA MEMSIZ TAX DEX STX A2L ;MEMSIZ-1 -> end ptr SBC LINNUM ;MEMSIZ-2-len -> start PHA LDA MEMSIZ+1 TAY INX BNE SL1 DEY SL1 STY A2H SBJ LINNUM+1 CMP STREND+1 BCC SL2 BNE SL3 ;Require page > STREND SL2 JMP MEMERR SL3 STA MEMSIZ+1 ;Set HIMEM and shape ptr STA FRETOP+1 ; to shape table STA A1H STA SHAPEPNT+1 PLA STA SHAPEPNT STA MEMSIZ STA FRETOP STA A1L JSR RD2BIT ;Find edge LDA #3 JMP MONREAD2 ;Read shape tbl to (A1L) TAPEPNT >>> ADD.LOWTR ;LINNUM;A2L LDY #4 LDA (LOWTR),Y JSR GETARY2 >>> TRDB.HIGHDS;A1L RTS * Non graphics stuff: GETARYPT LDA #$40 ;Called by STORE & RECALL STA SUBFLG JSR PTRGET LDA #0 STA SUBFLG JMP VARTIO * Note that if WNDLEFT is not 0, HTAB can print * outside the screen (eg., in the program). HTAB JSR GETBYT DEX TXA HTAB1 CMP #40 BLT HTAB2 SBC #40 PHA JSR CRDO PLA JMP HTAB1 HTAB2 STA CH RTS HEX CBD2D7 ;Left over *------------------------------------------------ * Applesoft zero page usage map: *------------------------------------------------ * KEY: X = General usage * . = Not used * C = Set by cold start but not used * H = Used by high resolution graphics only * G = Used by low resolution graphics only * T = Used by tape routines only * D = Important DOS use * $ = Used by STR$ routine only * U = Set up for USR, not otherwise used * 8 = Used by some 80 column cards *------------------------------------------------ * * 0 1 2 3 4 5 6 7 8 9 A B C D E F * ------------------------------- * 0X: C C C C C C . . . . U U U X X X * 1X: X X X X X X X . . . H H H H 8 8 * 2X: X X X X X X H H X X X X G G X T * 3X: G . X X . X X X X X . . T T T T * 4X: D D D D D D D D D D . . . . X X * 5X: X X X X X X X X X X X X X X X X * 6X: X X X X X X X X X X X X X X X X * 7X: X X X X X X X X X X X X X X X X * 8X: X X X X X X X X X X X X X X . X * 9X: X X X X X X X X X X X X X X X X * AX: X X X X X X X X X X X X X X X X * BX: X X X X X X X X X X X X X X X X * CX: X X X X X X X X X X X X X X . . * DX: H H H H H H X . X . X X X X X X * EX: H H H H H H H H H H H . . . . . * FX: X X X X X X X X X H . . . . . $ * ------------------------------- * 0 1 2 3 4 5 6 7 8 9 A B C D E F